home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / bled15.arc / BLED.BAS next >
Encoding:
BASIC Source File  |  1987-01-26  |  26.9 KB  |  960 lines
  1. REM ****************************************************************
  2. REM *         NOTICE:  DO NOT REMOVE THIS NOTICE                   *
  3. REM *         BLED - (C) 1985-1987 by Ken Goosens                  *
  4. REM *       5020 Portsmouth Road, Fairfax, VA 22032                *
  5. REM ****************************************************************
  6. REM 8 April 1986 enhanced to add comments to bled merge
  7. REM 13 April 1986 fixed bug so could embed source code in comments
  8. REM 1 June 1986 Added buffered output & increased default max lines
  9. REM 25 Jan 1987 Support for preserving BLED and BLED SOURCE comments
  10. REM *******************   DRIVER MODULE   **************************
  11.  
  12. DEFINT A-Z
  13.  
  14. NCNFG = 13
  15. DIM CWRDS$(10),FROW(3),FCOL(3),FPROMPT$(3),FFLDSIZE(3),FFLDTYPE$(3),_
  16.     FFLDVAL$(3),FHLP$(3),CROW(NCNFG),CCOL(NCNFG),CPRO$(NCNFG),_
  17.     CFLDSIZE(NCNFG),CFLDTYPE$(NCNFG),CFLDVAL$(NCNFG),CHLP$(NCNFG)
  18.  
  19. GOSUB DOCMDLINE
  20. GOSUB SETCONSTANTS
  21. GOSUB GETCONFIG
  22. LBLK = LEN(ENDBLK$)
  23. TRANSBLK$ = SPACE$(LBLK)
  24. OPEN "O",#4,WARNFILE$
  25. MAXBTWLINES = VAL(MAXBTWLINES$)
  26. REDIM MBUF$(MAXBTWLINES),TBUF$(MAXBTWLINES)
  27. IF RUN.BATCH=0 THEN GOSUB ASKMERGE
  28.  
  29. WHILE ANS$ <> "Q"
  30.    X = INSTR(CMVAL$,ANS$)
  31.    IF X>1 THEN PRINT #4,"--[WARNINGS FOR FUNCTION ";ANS$;"]--
  32.    FILE.COMPARE = (ANS$ = "F")
  33.    ON INSTR (CMVAL$,ANS$) GOSUB SETCONFIG,FILECOMPARE,DOLINEMERGE,DOMERGE
  34.    NWRITE = -1
  35.    CALL WRITENEW (X$,NWRITE)
  36.    CLOSE #3
  37.    COLOR 7,0
  38.    ANS$ = "Q"
  39.    IF RUN.BATCH=0 THEN GOSUB ASKMERGE
  40. WEND
  41. CLOSE #4
  42. LOCATE 24,1:PRINT
  43.       
  44. END
  45.  
  46. REM  *********************    GOSUBS    **************************
  47.  
  48. ASKMERGE:
  49.  
  50.    LOCATE CMRO,1
  51.    PRINT SPACE$(79)
  52.    CALL GETCHAR (CMRO,CMCO,CMPRO$,CMVAL$,ANS$)
  53.  
  54. RETURN
  55.  
  56. REM  ****              PREPATORY SUBROUTINES                  ****
  57. REM  **********  DOCMDLINE, SETCONSTANTS, GETCONFIG **************
  58.  
  59. REM -----------------------[ DOCMDLINE ]------------------------------------------------
  60.  
  61. DOCMDLINE:
  62.  
  63. REM PROCESSES COMMAND LINE ARGUMENTS FROM DOS
  64.  
  65.   RUN.BATCH  = INSTR(COMMAND$,"/B")
  66.   LINE.MERGE = INSTR(COMMAND$,"/L")
  67.   REG.MERGE  = INSTR(COMMAND$,"/M")
  68.   FILE.COMPARE = INSTR(COMMAND$,"/F")
  69.  
  70.   IF (LINE.MERGE OR REG.MERGE OR FILE.COMPARE)  THEN_
  71.   IF (LINE.MERGE AND REG.MERGE) OR (LINE.MERGE AND FILE.COMPARE) OR_
  72.      (REG.MERGE AND FILE.COMPARE) THEN_
  73.        X$="Can not use more than one of /F /L /M.":GOSUB DOABORT
  74.   IF REG.MERGE THEN ANS$="M" ELSE_
  75.      IF LINE.MERGE THEN ANS$="L" ELSE_
  76.      IF FILE.COMPARE THEN ANS$="F" ELSE ANS$=""
  77.   IF RUN.BATCH AND ANS$="" THEN_
  78.      X$="Must specify one of /F /L /M to run batch.":GOSUB DOABORT
  79.   CALL BRKWORDS (COMMAND$,CWRDS$())
  80.   NON.OPT = 1
  81.   WHILE INSTR(CWRDS$(NON.OPT),"/") > 0
  82.     NON.OPT = NON.OPT + 1
  83.   WEND
  84.   IF RUN.BATCH AND CWRDS$(NON.OPT+2)="" THEN_
  85.     X$="Must specify all three file arguments to run batch.":GOSUB DOABORT
  86.   IF COMMAND$="" THEN CALL CREDITS
  87.  
  88.   IF CWRDS$(NON.OPT+4)<>"" THEN_
  89.      CONFIGFILE$ = CWRDS$(NON.OPT+4)_
  90.   ELSE_
  91.      CONFIGFILE$ = "BLED.CFG"
  92.   IF CWRDS$(NON.OPT+3)<>"" THEN_
  93.      WARNFILE$ = CWRDS$(NON.OPT+3)_
  94.   ELSE_
  95.      WARNFILE$ = ""
  96.   IF CWRDS$(NON.OPT+2)<>"" THEN_
  97.      NEWFILE$=CWRDS$(NON.OPT+2) _
  98.   ELSE_
  99.      NEWFILE$="SC"
  100.   IF CWRDS$(NON.OPT+1)<>"" THEN_
  101.      BTCHCMDS$=CWRDS$(NON.OPT+1) _
  102.   ELSE_
  103.      BTCHCMDS$="SC"
  104.   IF CWRDS$(NON.OPT)<>"" THEN_
  105.      ORIGFILE$=CWRDS$(NON.OPT) _
  106.   ELSE_
  107.      ORIGFILE$="SC"
  108.  
  109.   LIMIT.RUN = INSTR(COMMAND$,"/T=")
  110.   IF LIMIT.RUN=0 THEN RETURN
  111.   LIMIT.RUN = LIMIT.RUN + 1
  112.   LAST.CHAR = INSTR(LIMIT.RUN,COMMAND$,"/")
  113.   IF LAST.CHAR=0 THEN LAST.CHAR = INSTR(LIMIT.RUN,COMMAND$," ")
  114.   IF LAST.CHAR=0 THEN LAST.CHAR = LEN(COMMAND$)+1
  115.   MAX.LL = VAL(MID$(COMMAND$,LIMIT.RUN+2,LAST.CHAR-LIMIT.RUN-2))
  116. REM  PRINT "MAX.LL=";MAX.LL;" GOT FROM ";COMMAND$;" starting at ";LIMIT.RUN+2;_
  117. REM    " and grabbing ";LAST.CHAR-LIMIT.RUN-2;" chars"
  118. REM   PRINT "Last char=";last.char: input xx$
  119. RETURN
  120.  
  121. DOABORT:
  122.  
  123. REM PREMATURELY TERMINATE WITH CENTERED ERROR MESSAGE AND HELP
  124.  
  125.   BEEP
  126.   X = LEN(X$)+17
  127.   IF X<78 THEN K = (78-X)/2 ELSE K=0
  128.   PRINT SPACE$(K);X$;"  Aborting."
  129.   CALL PRTHELP
  130.   END
  131.  
  132. RETURN
  133.  
  134. REM --------------------------[ SETCONSTANTS ]-----------------------------
  135.  
  136. SETCONSTANTS:
  137.  
  138. REM ASSIGNS CONSTANTS USED IN PROGRAM
  139.  
  140.   HI.VALUE# = 99999999
  141.   ONE = 1
  142.   TWO = 2
  143.   SEVENTYTWO = 72
  144.  
  145.   INSERTING$ = "* INSERTING new line(s)"
  146.   DELETING$ = "* DELETING old line(s)"
  147.   REPLACING$ = "* REPLACING old line(s) by new"
  148.   FIRSTDIF$ = "* ------[ first line different ]------"
  149.  
  150.   CMPRO$ = "C)onfigure, F)ile compare, L)ine# merge, M)erge, Q)uit (C,L,M,Q): "
  151.   CMRO = 21
  152.   CMCO = 5
  153.   CMVAL$ = "CFLMQ"
  154.  
  155.   EDPRO$ = "E)dit, R)un, Q)uit (E,R,Q): "
  156.   EDRO = 23
  157.   EDCO = 18
  158.   EDVAL$= "ERQ"
  159.  
  160.   CFRO = 23
  161.   CFCO = 20
  162.   CFPRO$ = "E)dit, S)ave, Q)uit (E,S,Q): "
  163.   CFVAL$ = "ESQ"
  164.  
  165.   THREE = 3
  166.   FOUR = 4
  167.   FROW(1) = 7
  168.   FROW(2) = 9
  169.   FROW(3) = 11
  170.   FCOL(1) = 10
  171.   FCOL(2) = 10
  172.   FCOL(3) = 10
  173.   FFLDSIZE(1) = 40
  174.   FFLDSIZE(2) = 40
  175.   FFLDSIZE(3) = 40
  176.   FFLDTYPE$(1) = "S"
  177.   FFLDTYPE$(2) = "S"
  178.   FFLDTYPE$(3) = "S"
  179.   IN.MERGE = -1
  180.  
  181.   FOR I = 1 TO NCNFG
  182.     READ CROW(I),CCOL(I),CPRO$(I),CFLDSIZE(I),CFLDTYPE$(I),CFLDVAL$(I),CHLP$(I)
  183.   NEXT
  184.  
  185. DATA  01,18,"BATCH LINE EDITOR - CONFIGURATION   Ver 1.5",00,L,   ,
  186. DATA  03,12,"Source EXTENSION:"                  ,03,S,BAS,"Default extension for source file to be edited (e.g. BAS)"
  187. DATA  04,12,"Merge EXTENSION:"                   ,03,S,MRG,"Default extension for file of changes to source (e.g. MRG)"
  188. DATA  05,12,"Source remarks begin with:"         ,03,S,"'","Logically ignore rest of physical line beyond this"
  189. DATA  06,12,"END OF BLOCK Phrase:"               ,20,S,ENDBLOCK,"Phrase used in BLED for the end of a block"
  190. DATA  07,12,"Documentation BEGINS with: "        ,01,S,*  ,"Character that documentation lines begin with in BLED merge file"
  191. DATA  08,12,"Alphanumeric LABELS END with:"      ,01,S,":","Character on end of an alphanumeric label (e.g. ':' in 'GETOUT:')"
  192. DATA  09,12,"BLED COMMANDS BEGIN with:"          ,01,S,   ,"Character starting BLED commands in merge file (default none)"
  193. DATA  10,12,"IGNORE CASE in Labels?"             ,01,S,Y  ,"Lower/upper case are same in labels (e.g. 'LABEL1' and 'label1')"
  194. DATA  11,12,"CONTINUED LINES END with:"          ,01,S,_  ,"Character used to continue logical line onto next line"
  195. DATA  12,12,"Write WARNINGS to:"                 ,30,S,WARNING,"File to write warning messages to"
  196. DATA  13,12,"Max # physical lines btw line #'s:" ,04,N,400,"In file compare, max # physical lines between two line numbers"
  197. DATA  14,12,"Preserve BLED comments (Y/N):"      ,01,S,Y  ,"Convert BLED comments to/from source BLED comments"
  198. RETURN
  199.  
  200. REM -------------------------[ GETCONFIG ]---------------------------------
  201.  
  202. GETCONFIG:
  203.  
  204. REM   GETS CONFIGURATION PARAMETERS
  205.  
  206.    ON ERROR GOTO NOCONFIG
  207.    OPEN "I",#1,CONFIGFILE$
  208.  
  209.    READIN:
  210.      ON ERROR GOTO 0
  211.      LINE INPUT #1,DESOURCE$
  212.      LINE INPUT #1,DEMERGES$
  213.      LINE INPUT #1,REMCHAR$
  214.      LINE INPUT #1,ENDBLK$
  215.      LINE INPUT #1,DOCCHAR$
  216.      LINE INPUT #1,END.LABEL$
  217.      LINE INPUT #1,BLEDCMD$
  218.      LINE INPUT #1,IGNORECASE$
  219.      LINE INPUT #1,LINEON$
  220.      LINE INPUT #1,X$
  221.      IF WARNFILE$ = "" THEN WARNFILE$ = X$
  222.      LINE INPUT #1,MAXBTWLINES$
  223.      LINE INPUT #1,X$
  224.      PRESERVE.COMMENTS = (LEFT$(X$,1)<>"N")
  225.      BLED.SOURCE.COMMENT$ = REMCHAR$ + "<" + DOCCHAR$ + ">"
  226.      CLOSE #1
  227.    RETURN
  228.  
  229.    USEDEFAULTS:
  230.      ON ERROR GOTO 0
  231.      DESOURCE$ = "BAS"
  232.      DEMERGES$ = "MRG"
  233.      REMCHAR$  = "'"
  234.      ENDBLK$     = "ENDBLOCK"
  235.      DOCCHAR$    = "*"
  236.      END.LABEL$  = ":"
  237.      BLEDCMD$    = ""
  238.      IGNORECASE$ = "Y"
  239.      LINEON$     = "_"
  240.      IF WARNFILE$ = "" THEN WARNFILE$ = "WARNING"
  241.      MAXBTWLINES$ = "400"
  242.      PRESERVE.COMMENTS = 0
  243.    RETURN
  244.  
  245. NOCONFIG:
  246.    X$ = "Config file "+CONFIGFILE$+" missing/bad.  Using QuickBASIC defaults."
  247.    CALL EXPLAIN(X$)
  248.    RESUME USEDEFAULTS
  249.  
  250. REM -----------------------------------------------------------------------
  251.  
  252. REM *****                MAIN   ROUTINES                       ****
  253. REM **********  SETCONFIG,FILECOMPARE,DOLINEMERGE,DOMERGE      ****
  254.  
  255. REM -----------------------[ SETCONFIG ]-----------------------------------
  256.  
  257. SETCONFIG:
  258.  
  259. REM      ALLOWS USER TO RECONFIGURE
  260.  
  261.    CFLDVAL$(2) = DESOURCE$
  262.    CFLDVAL$(3) = DEMERGES$
  263.    CFLDVAL$(4) = REMCHAR$
  264.    CFLDVAL$(5) = ENDBLK$
  265.    CFLDVAL$(6) = DOCCHAR$
  266.    CFLDVAL$(7) = END.LABEL$
  267.    CFLDVAL$(8) = BLEDCMD$
  268.    CFLDVAL$(9) = IGNORECASE$
  269.    CFLDVAL$(10)= LINEON$
  270.    CFLDVAL$(11)= WARNFILE$
  271.    OLDWARN$    = WARNFILE$
  272.    CFLDVAL$(12)= MAXBTWLINES$
  273.    CFLDVAL$(13)= MID$("NY",1-PRESERVE.COMMENTS,1)
  274.  
  275.    CALL PRTSCRN (NCNFG,CROW(),CCOL(),CPRO$(),CFLDSIZE(),CFLDTYPE$(),_
  276.                  CFLDVAL$(),CHLP$())
  277.    CO=1:CALL QPRINT (SPACE$(79),FRO,CO)
  278.    RESETCNFG:
  279.      ANS$="E"
  280.      CALL GETCHAR(CFRO,CFCO,CFPRO$,CFVAL$,ANS$)
  281.      WHILE ANS$ = "E"
  282.        CALL GETSCRN (NCNFG,CROW(),CCOL(),CPRO$(),CFLDSIZE(),CFLDTYPE$(),_
  283.                  CFLDVAL$(),CHLP$())
  284.        LOCATE CFRO,1:PRINT SPACE$(79)
  285.        ANS$="":CALL GETCHAR (CFRO,CFCO,CFPRO$,CFVAL$,ANS$)
  286.      WEND
  287.  
  288.  DESOURCE$ = CFLDVAL$(2)
  289.  BTCHCMDS$ = CFLDVAL$(3)
  290.  REMCHAR$  = CFLDVAL$(4)
  291.  ENDBLK$   = CFLDVAL$(5)
  292.  DOCCHAR$  = CFLDVAL$(6)
  293.  END.LABEL$ = CFLDVAL$(7)
  294.  BLEDCMD$   = CFLDVAL$(8)
  295.  IGNORECASE$ = CFLDVAL$(9)
  296.  LINEON$     = CFLDVAL$(10)
  297.  WARNFILE$   = CFLDVAL$(11)
  298.  MAXBTWLINES$= CFLDVAL$(12)
  299.  PRESERVE.COMMENTS = (LEFT$(CFLDVAL$(13),1)<>"N")
  300.  BLED.SOURCE.COMMENT$ = REMCHAR$ + "<" + DOCCHAR$ + ">"
  301.  IF WARNFILE$ <> OLDWARN$ THEN_
  302.    CLOSE #4:OPEN "O",#4,WARNFILE$
  303.  IF ANS$ = "Q" THEN RETURN  
  304.  IF ANS$ <> "S" THEN RETURN
  305.      OPEN "O",#1,CONFIGFILE$
  306.      FOR I = 1 TO NCNFG
  307.        IF CFLDTYPE$(I) <> "L" THEN PRINT #1,CFLDVAL$(I)
  308.      NEXT
  309.      CLOSE #1
  310.      GOTO RESETCNFG
  311.  
  312. RETURN
  313.  
  314. REM -----------------------[ FILECOMPARE ]---------------------------------
  315.  
  316. FILECOMPARE:
  317.  
  318. REM     COMPARES TWO FILES, PRODUCES MERGE FILE FOR LINE MERGING
  319.  
  320.   IN.MERGE = 0
  321.   FPROMPT$(1)= "OLD Version:"
  322.   FPROMPT$(2)= "NEW Version:"
  323.   FPROMPT$(3)= "MERGES (to OLD to make NEW):"
  324.   FHLP$(1)   = "Old version of file that has been changed"
  325.   FHLP$(2)   = "New, modified version of file"
  326.   FHLP$(3)   = "Create file of changes to old version needed to make new version"
  327.   TOPTITLE$ = "COMPARING FILES - Generating Merge"
  328.   GOSUB GETFILES
  329.   IF FANS$ = "Q" THEN RETURN
  330.  
  331.    HEADER$ = DOCCHAR$ + " ------------[ BLED merge (c) Ken Goosens ]-------------"
  332.    CALL WRITENEW (HEADER$,NWRITE)
  333.    HEADER$ = DOCCHAR$ + " Merge this against " + ORIGFILE$ + _
  334.              " to produce " + BTCHCMDS$
  335.    CALL WRITENEW (HEADER$,NWRITE)
  336.    CALL GETFDATE (ORIGFILE$+CHR$(0),MM,DD,YY)
  337.    FDATE$ = MID$(STR$(MM),2)+"-"+MID$(STR$(DD),2)+"-"+MID$(STR$(YY),2)
  338.    FSIZE$ = MID$(STR$(LOF(2)),2)+" bytes"
  339.    HEADER$ = DOCCHAR$ + " " + ORIGFILE$ + ":  Date " + FDATE$ + "  Size " + FSIZE$
  340.    CALL WRITENEW (HEADER$,NWRITE)
  341.    HEADER$ = DOCCHAR$ + " ------------[ Created "+DATE$+" "+TIME$+" ]------------"
  342.    CALL WRITENEW (HEADER$,NWRITE)
  343.  
  344.    TRANS# = 0
  345.    MAST#  = 0
  346.    GOSUB READLINETRANS
  347.    GOSUB READLINEOLD
  348.    WHILE MAST# < HI.VALUE# OR TRANS# < HI.VALUE#
  349.       IF TRANS# < MAST# THEN _
  350.          CALL WRITENEW (INSERTING$,NWRITE) : _
  351.          WHILE TRANS# < MAST#: _
  352.            GOSUB COMPARENUTRANS:_
  353.            CALL WRITENEW (NUTRANS$,NWRITE):_
  354.            GOSUB READLINETRANS:_
  355.          WEND
  356.       IF MAST# < TRANS# THEN _
  357.          CALL WRITENEW (DELETING$,NWRITE) : _
  358.          WHILE MAST# < TRANS# : _
  359.            PREV# = MAST# : _
  360.            FW$ = MID$(STR$(MAST#),2) : _
  361.            CALL WRITENEW (FW$,NWRITE) : _
  362.            WHILE PREV# = MAST# : _
  363.              GOSUB READLINEOLD : _
  364.            WEND: _
  365.          WEND
  366.       IF TRANS# = MAST# AND MAST# < HI.VALUE# THEN_
  367.          PREV# = TRANS#:J=0:_
  368.          WHILE PREV# = TRANS# AND J < MAXBTWLINES:_
  369.            J=J+1:TBUF$(J)=NUTRANS$:_
  370.            GOSUB READLINETRANS:_
  371.          WEND:_
  372.          I=0:_
  373.          WHILE PREV# = MAST# AND I<MAXBTWLINES:_
  374.            I=I+1:MBUF$(I)=TRANS$:_
  375.            GOSUB READLINEOLD:_
  376.          WEND:_
  377.          GOSUB CHKEXCEED:_
  378.          IF M$<>"" THEN_
  379.            N$="Logical line exceeds maximum physical lines.  Reconfigure":_
  380.            CALL WRMIS (M$,N$)_
  381.          ELSE_
  382.            GOSUB CHKDIF:_
  383.            IF ARE.DIFF THEN_
  384.              CALL WRITENEW (REPLACING$,NWRITE) : _
  385.              GOSUB COMPARETBUF: _
  386.              FOR I=1 TO K-1:CALL WRITENEW (TBUF$(I),NWRITE):NEXT :_
  387.              GOSUB WRITEDIF : _
  388.              FOR I=K TO MAX:CALL WRITENEW (TBUF$(I),NWRITE):NEXT :_
  389.              FOR I=MAX+1 TO MAXMAX:CALL WRITENEW (TBUF$(I),NWRITE):NEXT
  390.    WEND
  391.    CLOSE #1,#2
  392.    IN.MERGE = -1
  393.  
  394. RETURN
  395.  
  396. WRITEDIF:
  397.  
  398.    IF MAXMAX > 1 THEN _
  399.       CALL WRITENEW (FIRSTDIF$,NWRITE)
  400.  
  401.    RETURN
  402.  
  403. CHKEXCEED:
  404.  
  405.    M$ = ""
  406.    IF I=UBOUND(MBUF$) THEN_
  407.      M$="[File "+ORIGFILE$+"]"_
  408.    ELSE IF J = UBOUND(TBUF$) THEN_
  409.      M$="[File "+BTCHCMDS$+"]"
  410.  
  411. RETURN
  412.  
  413. CHKDIF:
  414.  
  415. IF I = J THEN _
  416.   ARE.DIFF = 0 _
  417. ELSE _
  418.   ARE.DIFF = -1
  419. IF I<=J THEN _
  420.    MAX = I _
  421. ELSE _
  422.    MAX = J 
  423. MAXMAX = J
  424. K=0
  425. CHKAG:
  426.   K=K+1:IF K<=MAX THEN IF TBUF$(K)=MBUF$(K) THEN GOTO CHKAG ELSE ARE.DIFF=-1
  427. GETOUTCHKDIF:
  428.  
  429. RETURN
  430.  
  431. COMPARENUTRANS:
  432.  
  433.    IF NOT PRESERVE.COMMENTS THEN RETURN
  434.    CALL FIRSTWORD (NUTRANS$,FW$,BEGIN.AT)
  435.    IF LEFT$(FW$,4) = BLED.SOURCE.COMMENT$ THEN _
  436.      NUTRANS$ = LEFT$(NUTRANS$,BEGIN.AT-1) + DOCCHAR$ + _
  437.                 RIGHT$(NUTRANS$,LEN(NUTRANS$)-BEGIN.AT-3)
  438.  
  439. RETURN
  440.  
  441. COMPARETBUF:
  442.  
  443.    IF NOT PRESERVE.COMMENTS THEN RETURN
  444.    FOR I=1 TO MAXMAX
  445.      CALL FIRSTWORD (TBUF$(I),FW$,BEGIN.AT)
  446.      IF LEFT$(FW$,4) = BLED.SOURCE.COMMENT$ THEN _
  447.        TBUF$(I) = LEFT$(TBUF$(I),BEGIN.AT-1) + DOCCHAR$ + " " + _
  448.           RIGHT$(TBUF$(I),LEN(TBUF$(I))-BEGIN.AT-3)
  449.    NEXT
  450.      
  451. RETURN
  452.  
  453. REM -----------------------[ DOLINEMERGE ]---------------------------------
  454.  
  455. DOLINEMERGE:
  456.  
  457. REM               MERGES BASED ON LINE NUMBER LABELS
  458.  
  459.   TOPTITLE$ = "MERGING using Line Number Labels"
  460.   GOSUB STANDARDFILES
  461.   IF FANS$ = "Q" THEN RETURN
  462.  
  463.    TRANS# = 0
  464.    MAST#  = 0
  465.    GOSUB READLINETRANS
  466.    GOSUB READLINEOLD
  467.    WHILE TRANS# < HI.VALUE# OR MAST# < HI.VALUE#
  468.       WHILE TRANS# < MAST# AND J < MAXBTWLINES
  469.         PREV# = TRANS#
  470.         J = 0
  471.         WHILE PREV# = TRANS#
  472.          IF ONLY.LINENO THEN_
  473.            M$=TRANS$:_
  474.            N$="Line number to be deleted not found.":_
  475.            CALL WRMIS (M$,N$)_
  476.          ELSE_
  477.            J = J+1 : _
  478.            TBUF$(J) = NUTRANS$
  479.          GOSUB READLINETRANS
  480.         WEND
  481.         FOR I=1 TO J:CALL WRITENEW(TBUF$(I),NWRITE):NEXT
  482.       WEND
  483.       WHILE MAST# < TRANS#
  484.          PREV# = MAST#
  485.          WHILE PREV# = MAST#
  486.            CALL WRITENEW (TRANS$,NWRITE)
  487.            GOSUB READLINEOLD
  488.          WEND
  489.       WEND
  490.       IF TRANS# = MAST# AND MAST# < HI.VALUE# THEN_
  491.          PREV# = TRANS#:J=0:_
  492.          WHILE PREV# = TRANS# AND J < MAXBTWLINES:_
  493.            GOSUB CHKWRITE:_
  494.            GOSUB READLINETRANS:_
  495.          WEND:_
  496.          FOR I=1 TO J:CALL WRITENEW(TBUF$(I),NWRITE):NEXT:_
  497.          WHILE PREV# = MAST#:_
  498.            GOSUB READLINEOLD:_
  499.          WEND
  500.    WEND
  501.    CLOSE #1,#2
  502.  
  503. RETURN
  504.  
  505. CHKWRITE:
  506.  
  507. IF NOT ONLY.LINENO THEN J=J+1:TBUF$(J)=NUTRANS$
  508.  
  509. RETURN
  510.  
  511. READLINEOLD:
  512.  
  513.    IF EOF(1) THEN_
  514.      MAST# = HI.VALUE#_
  515.    ELSE_
  516.      GOSUB READOLDREC:_
  517.      CALL FIRSTWORD (TRANS$,FW$,BEGIN.AT):_
  518.      IF FW$="" THEN PREV.MAST=0:RETURN_
  519.      ELSE_
  520.        CONTINUED.MAST = PREV.MAST:_
  521.        CALL CHKCONT (TRANS$,LINEON$,REMCHAR$,PREV.MAST):_
  522.        IF CONTINUED.MAST=0 THEN_
  523.          CALL NUMERIC (FW$,NATNO):_
  524.          IF NATNO THEN_
  525.            PREV# = MAST#:_
  526.            MAST# = VAL(FW$):_
  527.            IF MAST# <= PREV# THEN_
  528.              N$ = "Source line "+FW$+" occurs after line#"+STR$(PREV#):_
  529.              CALL WRMIS (TRANS$,N$)_
  530.            ELSE_
  531.              LOG.LINES = LOG.LINES + 1 : _
  532.              IF MAX.LL > 0 THEN _
  533.                 IF LOG.LINES > MAX.LL THEN _
  534.                    COLOR 7,0 : _
  535.                    PRINT : _
  536.                    PRINT "              Sample MERGE created from ";MAX.LL;" lines":_
  537.                    END
  538. rem IF (MAST# >= 9000 AND MAST# <= 9600) THEN_
  539. rem   X$="mast-out="+STR$(mast#)+" continued="+STR$(continued.mast)+" curr cont="+STR$(prev.mast)+" numeric="+STR$(natno):_
  540. rem    Y$="":CALL WRMIS (X$,Y$)
  541. RETURN
  542.  
  543. READLINETRANS:
  544.  
  545.     ONLY.LINENO = 0
  546.     IF EOF(2) THEN_
  547.       TRANS# = HI.VALUE#_
  548.     ELSE_
  549.       CALL GETTRANS (NUTRANS$,NTRANS):_
  550.       CALL FIRSTWORD (NUTRANS$,FW$,BEGIN.AT):_
  551.       IF FW$="" THEN PREV.CONT=0:RETURN_
  552.       ELSE IF (LEFT$(FW$,1)=DOCCHAR$ AND IN.MERGE) THEN_
  553.              GOSUB CHKPRESERVE:GOTO READLINETRANS_
  554.            ELSE CONTINUED.LINE = PREV.CONT:_
  555.                   CALL CHKCONT (NUTRANS$,LINEON$,REMCHAR$,PREV.CONT):_
  556.                   IF CONTINUED.LINE=0 THEN_
  557.                     CALL NUMERIC (FW$,NATNO):_
  558.                     IF NATNO THEN_
  559.                       PREV# = TRANS#:_
  560.                       TRANS# = VAL(FW$):_
  561.                       IF TRANS# <= PREV# THEN_
  562.                         N$ = "Merge line# "+FW$+" occurs after line#"+STR$(PREV#):_
  563.                         CALL WRMIS (NUTRANS$,N$)_
  564.                       ELSE_
  565.                         X$ = NUTRANS$:_
  566.                         CALL TRIM (X$):_
  567.                         IF X$ = FW$ THEN ONLY.LINENO = -1
  568. RETURN
  569.  
  570. CHKPRESERVE:
  571. REM print "chkpreserve: preserve?=";preserve.comments
  572.   IF NOT PRESERVE.COMMENTS THEN RETURN
  573.   IF INSTR(NUTRANS$,"-[ first") > 0 THEN RETURN
  574.   NUTRANS$ = LEFT$(NUTRANS$,BEGIN.AT-1) + BLED.SOURCE.COMMENT$ + _
  575.              RIGHT$(NUTRANS$,LEN(NUTRANS$)-BEGIN.AT)
  576.   CALL WRITENEW (NUTRANS$,NWRITE)
  577. REM print "<";nutrans$;">"
  578.  
  579. RETURN
  580.  
  581. REM -----------------------[ DOMERGE ]-------------------------------------
  582.  
  583. DOMERGE:
  584.  
  585. REM        GENERAL BLED MERGE BASED ON BLOCK and BLOCK DISPOSITION
  586.  
  587.   TOPTITLE$ = "MERGING - General BLED"
  588.   GOSUB STANDARDFILES
  589.   IF FANS$ = "Q" THEN RETURN
  590.   
  591.   CALL GETNXTCMD (CMD$,DOCCHAR$,STBLKTYPE$,ENDBLKTYPE$,STDES.NO%,ENDDES.NO%,_
  592.                  STTARGET$,ENDTARGET$,INCREMENT%,PTR%,CMD.TYPE$,_
  593.                  INS.BLKTYPE$,FIXED.NO%,BLK.DISP$)
  594.   
  595.   WHILE CMD.TYPE$ <> ""
  596. REM     PRINT "domerge: CMD$=";CMD$;" TYPE=";CMD.TYPE$;" INS BLKTYPE=";INS.BLKTYPE$
  597.      IF CMD.TYPE$ = "I" THEN_
  598.         IF INS.BLKTYPE$ = "L" THEN_
  599.             GOSUB WRNTIMES_
  600.         ELSE_
  601.             GOSUB WRTBLOCK_
  602.      ELSE_
  603.         LINE.DISP$ = "K":_
  604.         PTR.INCREMENT% = 1:_
  605.         TARGET$ = STTARGET$:_
  606.         BLOCK.TYPE$ = STBLKTYPE$:_
  607.         DESIRED.PTR = STDES.NO%:_
  608.         GOSUB ADVANCE:_
  609.         LINE.DISP$ = BLK.DISP$:_
  610.         BLOCK.TYPE$ = ENDBLKTYPE$:_
  611.         DESIRED.PTR = ENDDES.NO%:_
  612.         TARGET$ = ENDTARGET$:_
  613.         PTR.INCREMENT% = INCREMENT%:_
  614.         GOSUB ADVANCE
  615.      CALL GETNXTCMD (CMD$,DOCCHAR$,STBLKTYPE$,ENDBLKTYPE$,STDES.NO%,ENDDES.NO%,_
  616.                  STTARGET$,ENDTARGET$,INCREMENT%,PTR%,CMD.TYPE$,_
  617.                  INS.BLKTYPE$,FIXED.NO%,BLK.DISP$)
  618.  
  619.   WEND
  620.   CLOSE #1,#2
  621.   
  622. RETURN
  623.  
  624. ADVANCE:
  625.       REM DECIDES HOW TO ADVANCE THROUGH OLD FILE
  626.       REM PASS BLOCK.TYPE$
  627.  
  628.       IF BLOCK.TYPE$ = "L" THEN_
  629.           GOSUB READTOLINE_
  630.       ELSE IF BLOCK.TYPE$ = "S" THEN_
  631.           GOSUB READTOSTRING_
  632.       ELSE IF BLOCK.TYPE$ = "LABEL" OR BLOCK.TYPE$="LABEL#" THEN_
  633.           GOSUB READTOLABEL_
  634.       ELSE_
  635.           M$="WARNING: ILLEGAL BLOCK TYPE ":_
  636.           W$=BLOCK.TYPE$:_
  637.           CALL WRMIS (M$,W$)
  638. RETURN
  639.          
  640. READTOLINE:
  641.  
  642.    REM READS UPTO LINE DESIRED.PTR IN OLD
  643.  
  644.    WHILE PTR% < DESIRED.PTR AND NOT EOF(1)
  645.       GOSUB READOLD
  646.       PTR% = PTR% + PTR.INCREMENT%
  647.       IF LINE.DISP$ = "K" THEN CALL WRITENEW (TRANS$,NWRITE)
  648.    WEND
  649. RETURN
  650.  
  651. READTOSTRING:
  652.  
  653.    REM READS UPTO A STRING IN OLD
  654.  
  655.    TRANS$ = TARGET$
  656.    IF NOT EOF(1) THEN GOSUB READOLD
  657.    WHILE INSTR(TRANS$,TARGET$) = 0
  658.       PTR% = PTR% + 1
  659.       IF LINE.DISP$ = "K" THEN CALL WRITENEW (TRANS$,NWRITE)
  660.       IF NOT EOF(1) THEN_
  661.          GOSUB READOLD_
  662.       ELSE_
  663.          M$ = "WARNING: STRING "+TARGET$+" NOT FOUND":_
  664.          W$ = "":_
  665.          CALL WRMIS (M$,W$):_
  666.          TRANS$ = TARGET$
  667.    WEND
  668.    PREV.OLD$ = TRANS$
  669.  
  670. RETURN
  671.  
  672. READTOLABEL:
  673.  
  674.    REM READS UPTO A LABEL IN OLD
  675.  
  676.    IF IGNORECASE THEN CALL UPCASE (TARGET$)
  677.    IF BLOCK.TYPE$ = "LABEL" AND RIGHT$(TARGET$,1) <> END.LABEL$ THEN_
  678.       TARGET$ = TARGET$ + END.LABEL$
  679.    IF NOT EOF(1) THEN_
  680.       GOSUB READOLD:_
  681.       GOSUB GETFIRSTWORD_
  682.    ELSE_
  683.       FIRST.WORD$ = TARGET$:_
  684.       TRANS$ = ""
  685.    WHILE FIRST.WORD$ <> TARGET$
  686.       PTR% = PTR% + 1
  687.       IF LINE.DISP$ = "K" THEN CALL WRITENEW (TRANS$,NWRITE)
  688.       IF NOT EOF(1) THEN_
  689.          GOSUB READOLD:_
  690.          GOSUB GETFIRSTWORD_
  691.       ELSE_
  692.          M$ = "WARNING: LABEL "+TARGET$+" NOT FOUND":_
  693.          W$ = "":_
  694.          CALL WRMIS (M$,W$):_
  695.          FIRST.WORD$ = TARGET$
  696.    WEND
  697.    PREV.OLD$ = TRANS$
  698.  
  699. RETURN
  700.  
  701. GETFIRSTWORD:
  702.  
  703.    CALL FIRSTWORD (TRANS$,FIRST.WORD$,BEGIN.AT)
  704.    IF IGNORECASE THEN CALL UPCASE (FIRST.WORD$)
  705.  
  706. RETURN
  707.  
  708. READOLD:
  709.  
  710.    REM FETCHES NEXT UNPROCESSED RECORD FROM OLD
  711.  
  712.    IF PTR% <= NREAD THEN_
  713.       TRANS$ = PREV.OLD$_
  714.    ELSE_
  715.       GOSUB READOLDREC
  716.  
  717. RETURN
  718.  
  719. READOLDREC:
  720.  
  721.    LINE INPUT #1,TRANS$
  722.    NREAD = NREAD+1
  723.    LOCATE MROW,MCOL:PRINT NREAD;
  724.  
  725. RETURN
  726.  
  727. WRNTIMES:
  728.    REM WRITES EXACTLY N RECORDS FROM TRANSACTION FILE
  729.  
  730.    WHILE FIXED.NO% > 0 AND NOT EOF(2)
  731.       GOSUB READTRANS
  732.       FIXED.NO% = FIXED.NO% - 1
  733.       CALL WRITENEW (NUTRANS$,NWRITE)
  734.    WEND
  735. RETURN
  736.  
  737. READTRANS:
  738.  
  739.    REM FETCHES NEXT DATA (NON-COMMAND) RECORD FROM TRANSACTION FILE
  740.    REM NOTE: WILL NOT SKIP OVER ANY LINES
  741.  
  742.    CALL GETTRANS (NUTRANS$,NTRANS)
  743.    CALL FIRSTNB (NUTRANS$,ONE,BS):IF BS<1 THEN BS=1
  744.    LSET TRANSBLK$ = MID$(NUTRANS$,BS,LBLK)
  745. REM   print "RT BS=";BS;" trans=";trans$;" transblk=<";transblk$;"> endblk=<";endblk$;">"
  746.  
  747. RETURN
  748.  
  749. WRTBLOCK:
  750.  
  751.    REM INSERT ROUTINE WHEN BLOCK
  752.  
  753.    IF NOT EOF(2) THEN GOSUB READTRANS
  754.    WHILE TRANSBLK$ <> ENDBLK$ AND NOT EOF(2)
  755.       CALL WRITENEW (NUTRANS$,NWRITE)
  756.       GOSUB READTRANS
  757.    WEND
  758.  
  759. RETURN
  760.  
  761. REM --------------------[ SHARED ROUTINES ]-----------------------------
  762.  
  763. GETFILES:
  764.  
  765. REM PROMPTS FOR 3 FILE NAMES NEEDED
  766.  
  767.    GOSUB CHKEXTENSIONS
  768.    FFLDVAL$(1) = ORIGFILE$
  769.    FFLDVAL$(2) = BTCHCMDS$
  770.    FFLDVAL$(3) = NEWFILE$
  771.    CALL PRTSCRN (THREE,FROW(),FCOL(),FPROMPT$(),FFLDSIZE(),FFLDTYPE$(),_
  772.                  FFLDVAL$(),FHLP$())
  773.    CALL CENTERBEG (TOPTITLE$,SEVENTYTWO,BEG)
  774.    CALL QPRINT (TOPTITLE$,FOUR,BEG)
  775.    IF RUN.BATCH THEN FANS$="R":GOTO GOTFILES
  776.  
  777.      CO=1:CALL QPRINT (SPACE$(79),FRO,CO)
  778.      FANS$="E"
  779.      CALL GETCHAR(EDRO,EDCO,EDPRO$,EDVAL$,FANS$)
  780.      WHILE FANS$ = "E"
  781.        CALL GETSCRN (THREE,FROW(),FCOL(),FPROMPT$(),FFLDSIZE(),FFLDTYPE$(),_
  782.                FFLDVAL$(),FHLP$())
  783.        LOCATE EDRO,1:PRINT SPACE$(79)
  784.        FANS$="":CALL GETCHAR (EDRO,EDCO,EDPRO$,EDVAL$,FANS$)
  785.      WEND
  786.  
  787.    GOTFILES:  
  788.    IF FANS$<>"Q" THEN_
  789.      GOSUB PREPARECOUNTS:_
  790.      ORIGFILE$ = FFLDVAL$(1):_
  791.      BTCHCMDS$ = FFLDVAL$(2):_
  792.      NEWFILE$  = FFLDVAL$(3):_
  793.      GOSUB OPENFILES:_
  794.      PRINT #4,"--[USING FILES ";ORIGFILE$;" ";BTCHCMDS$;" ";NEWFILE$;"]--"
  795.  
  796. RETURN
  797.  
  798. CHKEXTENSIONS:
  799.  
  800.    IF INSTR(ORIGFILE$,".")=0 THEN ORIGFILE$=ORIGFILE$+"."+DESOURCE$
  801.    IF INSTR(BTCHCMDS$,".")=0 THEN_
  802.      IF FILE.COMPARE THEN_
  803.        BTCHCMDS$=BTCHCMDS$+"."+DESOURCE$_
  804.      ELSE_
  805.        BTCHCMDS$=BTCHCMDS$+"."+DEMERGES$
  806.    IF INSTR(NEWFILE$,".")=0 THEN_
  807.      IF FILE.COMPARE THEN_
  808.        NEWFILE$=NEWFILE$+"."+DEMERGES$_
  809.      ELSE_
  810.        NEWFILE$=NEWFILE$+"."+DESOURCE$
  811.  
  812. RETURN
  813.  
  814. PREPARECOUNTS:
  815.  
  816.   COLOR 0,7
  817.   LOCATE 24,1
  818.   PRINT SPACE$(79);
  819.   LOCATE 24,04:PRINT "SOURCE:";
  820.   LOCATE 24,23:PRINT "CHANGES:";
  821.   LOCATE 24,42:PRINT "NEW:";
  822.   LOCATE 24,60:PRINT "WARNINGS:";
  823.  
  824.   TROW = 24
  825.   TCOL = 31
  826.   WROW = 24
  827.   WCOL = 46
  828.   MROW = 24
  829.   MCOL = 11
  830.   WROW = 24
  831.   WCOL = 69
  832.  
  833. RETURN
  834.  
  835. STANDARDFILES:
  836.  
  837.   FHLP$(1) = "Text file to be edited (e.g. source code in TEST.BAS)"
  838.   FHLP$(2) = "Merges (edits, changes) to be applied (e.g. TEST.MRG)"
  839.   FHLP$(3) = "Save changes made in this file (e.g. old + merges -> TESTNEW.BAS)"
  840.   FPROMPT$(1)= "SOURCE File:"
  841.   FPROMPT$(2)= " MERGE File:"
  842.   FPROMPT$(3)= "   NEW File:"
  843.   GOSUB GETFILES
  844.  
  845. RETURN
  846.  
  847. OPENFILES:
  848.  
  849.   ON ERROR GOTO ERROPEN
  850.   FF$ = ORIGFILE$
  851.   OPEN "I",#1,FF$
  852.   FF$ = BTCHCMDS$
  853.   OPEN "I",#2,FF$
  854.   FF$ = NEWFILE$
  855.   OPEN "O",#3,FF$
  856.   ON ERROR GOTO 0
  857.  
  858.   NREAD = 0
  859.   NWRITE = 0
  860.   NTRANS = 0
  861.   PTR% = 1
  862.  
  863. RETURN
  864.  
  865. ERROPEN:
  866.    X$ = "Error"+STR$(ERR)+" opening file "+FF$
  867.    CALL EXPLAIN(X$)
  868.    FLDSIZ = 30
  869.    RO = 23:CO = 1:CALL QPRINT (SPACE$(79),RO,CO)
  870.    CO=13:PROMPT$ = "Enter file name (<rtn> quits): "
  871.    FFF$ = ""
  872.    CALL GETSTR (RO,CO,PROMPT$,FLDSIZ,FFF$)
  873.    IF FFF$ = "" THEN RESUME QUITMERGE ELSE FF$=FFF$:GOSUB PREPARECOUNTS:RESUME
  874. QUITMERGE: FANS$="Q":RETURN
  875.  
  876. REM *****************   SHARED CALLED SUBROUTINES   *****************
  877.  
  878. SUB WRITENEW (NEWOUT$,NWRITE%) STATIC
  879.  
  880. REM WRITES NEWOUT$ TO NEW FILE
  881.  
  882.    DEFINT A-Z
  883.    DIM OBUF$(100)
  884.    IF NWRITE% < 0 THEN _
  885.      FOR I=1 TO NUM.IN.BUF: _
  886.        PRINT #3,OBUF$(I):_
  887.      NEXT:_
  888.      NUM.IN.BUF = 0:_
  889.      EXIT SUB
  890.    IF NUM.IN.BUF = 100 THEN _
  891.      FOR I=1 TO 100:_
  892.        PRINT #3,OBUF$(I):_ 
  893.      NEXT:_
  894.      NUM.IN.BUF = 0
  895.    NUM.IN.BUF = NUM.IN.BUF + 1
  896.    OBUF$(NUM.IN.BUF) = NEWOUT$
  897.    NWRITE% = NWRITE% + 1
  898.    LOCATE 24,46:PRINT NWRITE;
  899.  
  900. END SUB
  901.  
  902. SUB CHKCONT (STRNG$,LINEON$,REMCHAR$,CONTINUED%) STATIC
  903.  
  904. REM CHECKS WHETHER LINE STRNG$ CONTINUES LOGICALLY TO NEXT LINE
  905.  
  906. DEFINT A-Z
  907. rem IF DEB=0 THEN DEB = INSTR(STRNG$,"9150 IF")
  908. rem IF DEB>0 THEN IF INSTR(STRNG$,"9510 US") THEN DEB = 0
  909. CONTINUED%=0
  910. ONE = 1
  911. BS = 1
  912. LS = LEN(STRNG$)
  913. LCO = INSTR(STRNG$,LINEON$)
  914. IF LCO=0 THEN GOTO GETOUTCHKCONT
  915.   CHKREM:
  916.     X = INSTR(BS,STRNG$,REMCHAR$)
  917.     IF X=0 THEN_
  918.        X$=STRNG$:GOTO ALLSTRNG_
  919.     ELSE_
  920.        CALL FIRSTNB (STRNG$,ONE,XX):_
  921.        IF X=XX THEN GOTO GETOUTCHKCONT
  922.     CALL INQUOTES (STRNG$,X,INQUO)
  923.     IF INQUO>0 THEN BS=INQUO+1:IF BS<=LS THEN GOTO CHKREM
  924.     X$ = LEFT$(STRNG$,X-1)
  925.   ALLSTRNG:
  926.     CALL ENDNB (X$,ES)
  927.     CONTINUED% = (MID$(X$,ES,1) = LINEON$)
  928. REM    IF CONTINUED% <> 0 THEN PRINT "es=";es;" checking char <";MID$(X$,ES,1);">  CONT?=";CONTINUED%
  929. GETOUTCHKCONT:
  930. rem IF DEB>0 THEN_
  931. rem   PRINT "CONT?=";CONTINUED%;" for >";STRNG$;"<":_
  932. rem   PRINT "LCO=";LCO;" REM POS =";X;" INQUO=";INQUO;" BS= ";BS;" ES=";ES;:INPUT XX$:PRINT
  933. END SUB
  934.  
  935. SUB INQUOTES (STRNG$,BS%,INQUO%) STATIC
  936.  
  937. REM CHECKS WHETHER CHARACTER AT POSITION BS% IN STRNG$
  938. REM        IS INSIDE A PAIR OF QUOTES.  RETURNS POSITION OF RIGHT QUOTE
  939. REM        IF INSIDE, 0 IF NOT INSIDE
  940.  
  941. DEFINT A-Z
  942. QUOTE$=CHR$(34)
  943. BEG = 1
  944. INQUO% = 0
  945. CHKQAGAIN:
  946.   FQUO = INSTR(BEG,STRNG$,QUOTE$)
  947.   IF FQUO=0 THEN GOTO GETOUTINQUOTES
  948.   IF BS%<=FQUO THEN GOTO GETOUTINQUOTES
  949.   SQUO = INSTR(FQUO+1,STRNG$,QUOTE$)
  950.   IF SQUO=0 THEN GOTO GETOUTINQUOTES
  951.   IF BS% < SQUO THEN_
  952.     INQUO%=SQUO:GOTO GETOUTINQUOTES
  953.   BEG = SQUO+1
  954. GOTO CHKQAGAIN
  955.   
  956. GETOUTINQUOTES:
  957. REM PRINT "INQUOTES: LOOKING AT POS ";BS%;"<";MID$(STRNG$,BS%,1);"> SENDING INQUO=";INQUO%
  958. END SUB
  959.  
  960.